00000001  $ RESET LIST STACK                                                                
00100000 PROCEDURE PASCALERRORFINDER(A);                                                    
00101000  ARRAY A[*];                                                                       
00102000  BEGIN                                                                             
00103000  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%                  
00104000  %  DESCRIPTION:                                                                   
00105000  %    THIS PROCEDURE MAY BE USED TO FIND THE PASCAL ERROR       %                  
00106000  %    MESSAGE THAT CORRESPONDS TO AN ERRORCODE.                 %                  
00107000  %    IT MAY BE RUN INTERACTIVELY BY PROVIDING EITHER AN EMPTY  %                  
00108000  %    STRING OR "*" AS A PARAMETER OR AN ERRORCODE MAY BE       %                  
00109000  %    SUPPLIED AS THE PARAMETER.                                %                  
00110000  %       E.G.                                                   %                  
00111000  %         RUN PASCAL/ERRORFINDER("*")                          %                  
00112000  %         RUN PASCAL/ERRORFINDER(" ")                          %                  
00113000  %         RUN PASCAL/ERRORFINDER("1234")                       %                  
00114000  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%                  
00115000                                                                                    
00116000  $ INCLUDE "PASCAL/NEWTAPE."  464900-528600                                        
00117000                                                                                    
00118000  DEFINE  ERRORNUMBERF  = [15:16]#                                                  
00119000         ,ERRMSGLENGTHF = [47:16]#                                                  
00120000         ,ERRMSGINDEXF  = [31:16]#                                                  
00121000         ;                                                                          
00122000  POINTER P,Q,PTR;                                                                  
00123000  FILE F(KIND=REMOTE,MYUSE=IO,FILETYPE=3,MAXRECSIZE=80,                             
00124000         UNITS=CHARACTERS);                                                         
00125000  EBCDIC ARRAY AE,INA [0:79];                                                       
00126000  DEFINE BLANKIT   = REPLACE P:=AE BY " " FOR SIZE(AE)#                             
00127000        ,WRITEIT   =                                                                
00128000           BEGIN                                                                    
00129000             WRITE(F,OFFSET(P),AE);                                                 
00130000             BLANKIT;                                                               
00131000           END#                                                                     
00132000        ,INSERT    = REPLACE P:P BY#                                                
00133000        ;                                                                           
00134000  INTEGER J,ERRCODE,NUMLEFT;                                                        
00135000  BOOLEAN INTERACTIVE,FINISHED;                                                     
00136000  TRUTHSET NUMBERS("0123456789");                                                   
00137000                                                                                    
00138000  PROCEDURE PRINTMESSAGE(ERRCODE);                                                  
00139000   VALUE ERRCODE;                                                                   
00140000   INTEGER ERRCODE;                                                                 
00141000   BEGIN                                                                            
00142000     INTEGER I,INDEX,MSGLENGTH;                                                     
00143000     BOOLEAN FOUND;                                                                 
00144000                                                                                    
00145000     FOR I:=0 STEP 1 WHILE (I LSS NOOFERRORNUMBERS) AND                             
00146000                           (NOT FOUND)  DO                                          
00147000      BEGIN                                                                         
00148000        FOUND:=ERRORMESSAGEINDEX[I].ERRORNUMBERF = ERRCODE;                         
00149000        INDEX:=I;                                                                   
00150000      END;                                                                          
00151000     IF FOUND THEN                                                                  
00152000     BEGIN                                                                          
00153000       MSGLENGTH:=ERRORMESSAGEINDEX[INDEX].ERRMSGLENGTHF;                           
00154000       INDEX:=ERRORMESSAGEINDEX[INDEX].ERRMSGINDEXF;                                
00155000       INSERT "ERROR # ",ERRCODE FOR * DIGITS, "   ",                               
00156000              "MSGLENGTH = ",MSGLENGTH FOR * DIGITS, "   ",                         
00157000              "ARRAY INDEX = ",INDEX FOR * DIGITS;                                  
00158000       WRITEIT;                                                                     
00159000       INSERT POINTER(ERRORMESSAGETEXT[INDEX],8) FOR                                
00160000                  MIN(MSGLENGTH,80);                                                
00161000       WRITEIT;                                                                     
00162000     END                                                                            
00163000     ELSE                                                                           
00164000     BEGIN                                                                          
00165000       WRITE(F,<"NO SUCH ERRORCODE AS # ",I6>,ERRCODE);                             
00166000     END;                                                                           
00167000  END OF PRINTMESSAGE;                                                              
00168000               %%%%%  M A I N  %%%%%                                                
00169000  BLANKIT;                                                                          
00170000  NUMLEFT:=SIZE(A) * 6;                                                             
00171000  Q:=POINTER(A[0],8);                                                               
00172000  SCAN Q:Q FOR NUMLEFT:NUMLEFT WHILE EQL " ";                                       
00173000  INTERACTIVE:=IF NUMLEFT EQL 0 THEN TRUE                                           
00174000                 ELSE Q EQL "*" FOR 1;                                              
00175000  FINISHED:=FALSE;                                                                  
00176000  IF INTERACTIVE THEN                                                               
00177000  BEGIN                                                                             
00178000    WHILE NOT FINISHED DO                                                           
00179000    BEGIN                                                                           
00180000      WRITE(F[STOP],<"ENTER PASCAL ERROR CODE : ">);                                
00181000      IF NOT FINISHED:=READ(F,80,INA) THEN                                          
00182000        BEGIN                                                                       
00183000          NUMLEFT:=REAL(FINISHED).[47:20];                                          
00184000          SCAN Q:INA FOR NUMLEFT:NUMLEFT WHILE IN NUMBERS;                          
00185000          IF OFFSET(Q) EQL 0 THEN                                                   
00186000            WRITE(F,<"BADLY FORMED NUMBER =>",A*>,                                  
00187000                         MIN(NUMLEFT,10),Q)                                         
00188000          ELSE                                                                      
00189000          BEGIN                                                                     
00190000            ERRCODE:=INTEGER(INA[0],OFFSET(Q));                                     
00190100            SPACE(F,1);                                                             
00191000            PRINTMESSAGE(ERRCODE);                                                  
00191100            SPACE(F,1);                                                             
00192000          END;                                                                      
00193000        END;                                                                        
00194000    END;                                                                            
00195000  END                                                                               
00196000  ELSE   %  JUST THE ONE                                                            
00197000  BEGIN                                                                             
00198000    SCAN PTR:Q FOR NUMLEFT:NUMLEFT WHILE IN NUMBERS;                                
00199000    IF J:=DELTA(Q,PTR) EQL 0 THEN                                                   
00200000      WRITE(F,<"BADLY FORMED NUMBER =>",A*>,MIN(NUMLEFT,10),PTR)                    
00201000    ELSE                                                                            
00202000    BEGIN                                                                           
00203000      ERRCODE:=INTEGER(Q,J);                                                        
00204000      PRINTMESSAGE(ERRCODE);                                                        
00205000    END;                                                                            
00206000  END;                                                                              
00207000 END OF PASCALERRORFINDER.                                                          
00208000                                                                                    